perm filename PCHECK.M1[226,JMC] blob
sn#005392 filedate 1972-07-09 generic text, type T, neo UTF8
00100 PUTPROP('LAMBDA,'LAMSTAT,'STAT);
00200 PUTPROP('GO,'GOSTAT,'STAT);
00300
00400 EVALUATECAR ARG ←
00500 BEGIN SCALAR NEWSTAT;
00600 IF ¬VALID(NEWSTAT←CARQUOTE ARG) THEN
00700 ERREND '(NOT A QUOTED EXPRESSION) ELSE
00800 ADDLINE(NEWSTAT,LIST('EVCAR,ARG),NIL);
00900 SHOWCURLINE();
01000 END;
01100
01200 CARQUOTE(ARG)←IF ATOM ARG ∨ ¬(CAR ARG EQ 'QUOTE)∨ ATOM CDR ARG
01300 ∨ ¬NULL CDDR ARG THEN 'INVALID
01400 ELSE LIST('EQUAL,LIST('CAR,ARG),
01500 IF ATOM CADR ARG THEN 'UU
01600 ELSE LIST('QUOTE,CAADR ARG));
01700
01800 FEXPR EVCAR ARG ← EVALUATECAR CAR ARG;
01900
02000 EVALUATECDR ARG ←
02100 BEGIN SCALAR NEWSTAT;
02200 IF ¬VALID(NEWSTAT←CDRQUOTE ARG) THEN
02300 ERREND '(NOT A QUOTED EXPRESSION) ELSE
02400 ADDLINE(NEWSTAT,LIST('EVCDR,ARG),NIL);
02500 SHOWCURLINE();
02600 END;
02700
02800 CDRQUOTE(ARG)←IF ATOM ARG ∨ ¬(CAR ARG EQ 'QUOTE)∨ ATOM CDR ARG
02900 ∨ ¬NULL CDDR ARG THEN 'INVALID
03000 ELSE LIST('EQUAL,LIST('CDR,ARG),
03100 IF ATOM CADR ARG THEN 'UU
03200 ELSE LIST('QUOTE,CDADR ARG));
03300
03400 FEXPR EVCDR ARG ← EVALUATECDR CAR ARG;
03500
03600 EVALUATECONS(ARG1,ARG2) ←
03700 BEGIN SCALAR NEWSTAT;
03800 IF ¬VALID(NEWSTAT←CONSQUOTE(ARG1,ARG2)) THEN
03900 ERREND '(NOT BOTH QUOTED EXPRESSIONS) ELSE
04000 ADDLINE(NEWSTAT,LIST('EVCONS,ARG1,ARG2),NIL);
04100 SHOWCURLINE();
04200 END;
04300
04400 CONSQUOTE(ARG1,ARG2) ←
04500 (LAMBDA(W1,W2);
04600 IF ¬(VALID W1 ∧ VALID W2) THEN 'INVALID
04700 ELSE LIST('EQUAL,LIST('CONS,ARG1,ARG2),
04800 LIST('QUOTE,CONS(SUBLIS(W1,'PPP),
04900 SUBLIS(W2,'PPP)))))
05000 (INST(ARG1,'(QUOTE PPP),NIL),INST(ARG2,'(QUOTE PPP),NIL));
05100
05200 FEXPR EVCONS ARG ← EVALUATECONS(CAR ARG,CADR ARG);
05300
05400 EVALUATEEQUAL(ARG1,ARG2) ←
05500 BEGIN SCALAR NEWSTAT;
05600 IF ¬VALID(NEWSTAT←EQUALQUOTE(ARG1,ARG2)) THEN
05700 ERREND '(NOT BOTH QUOTED EXPRESSIONS) ELSE
05800 ADDLINE(NEWSTAT,LIST('EVEQUAL,ARG1,ARG2),NIL);
05900 SHOWCURLINE();
06000 END;
06100
06200 EQUALQUOTE(ARG1,ARG2) ←
06300 (LAMBDA(W1,W2);
06400 IF ¬(VALID W1 ∧ VALID W2) THEN 'INVALID
06500 ELSE IF W1=W2 THEN LIST('EQUAL,ARG1,ARG2)
06600 ELSE LIST('NOT,LIST('EQUAL,ARG1,ARG2)))
06700 (INST(ARG1,'(QUOTE PPP),NIL),INST(ARG2,'(QUOTE PPP),NIL));
06800
06900 FEXPR EVEQUAL ARG ← EVALUATEEQUAL(CAR ARG,CADR ARG);
07000
07100 EVALUATEATOM(ARG) ←
07200 BEGIN SCALAR NEWSTAT;
07300 IF ¬VALID(NEWSTAT←ATOMQUOTE ARG) THEN
07400 ERREND '(NOT A QUOTED EXPRESSION) ELSE
07500 ADDLINE(NEWSTAT,LIST('EVATOM,ARG),NIL);
07600 SHOWCURLINE();
07700 END;
07800
07900 ATOMQUOTE ARG ←
08000 (LAMBDA(W);
08100 IF ¬VALID W THEN 'INVALID
08200 ELSE IF ATOM SUBLIS(W,'PPP) THEN LIST('ATOM,ARG)
08300 ELSE LIST('NOT,LIST('ATOM,ARG)))
08400 (INST(ARG,'(QUOTE PPP),NIL));
08500
08600 FEXPR EVATOM ARG ← EVALUATEATOM CAR ARG;
08700
08800 EVALUATESEXP(ARG) ←
08900 BEGIN SCALAR NEWSTAT;
09000 IF ¬VALID(NEWSTAT←SEXPQUOTE ARG) THEN
09100 ERREND '(NOT A QUOTED EXPRESSION) ELSE
09200 ADDLINE(NEWSTAT,LIST('ISSEXP,ARG),NIL);
09300 SHOWCURLINE();
09400 END;
09500
09600 SEXPQUOTE ARG ←
09700 (LAMBDA(W);
09800 IF ¬VALID W THEN 'INVALID
09900
10000 ELSE LIST('ISSEXP,ARG))
10100 (INST(ARG,'(QUOTE PPP),NIL));
10200
10300 FEXPR ISSEXP ARG ← EVALUATESEXP CAR ARG;
10400
10500 EVALUATELIST(ARG) ←
10600 BEGIN SCALAR NEWSTAT;
10700 IF ¬VALID(NEWSTAT←LISTQUOTE ARG) THEN
10800 ERREND '(NOT A LIST OF QUOTED EXPRESSIONS) ELSE
10900 ADDLINE(NEWSTAT,'EVLIST.ARG,NIL);
11000 SHOWCURLINE();
11100 END;
11200
11300 LISTQUOTE ARGS ←
11400 IF LISTOK ARGS THEN
11500 LIST('EQUAL,CONS('LIST,ARGS),LIST('QUOTE,
11600 MAPLIST(FUNCTION CADAR,ARGS)))
11700 ELSE 'INVALID ;
11800
11850 LISTOK ARGS ← NULL ARGS ∨ (VALID INST(ARGS,'((QUOTE PPP).QQQ),NIL)
11875 ∧LISTOK CDR ARGS);
11900
12000 FEXPR EVLIST ARGS ← EVALUATELIST ARGS;
12100
12200 EVALUATEEVAL(ARG) ←
12300 BEGIN SCALAR NEWSTAT;
12400 IF ¬VALID(NEWSTAT←EVALLQUOTE ARG) THEN
12500 ERREND '(NOT PROPERLY EVALUABLE EXPRESSION) ELSE
12600 ADDLINE(NEWSTAT,LIST('EVEVAL,ARG),NIL);
12700 SHOWCURLINE();
12800 END;
12900
13000 EVALLQUOTE ARG ←
13100 IF EVALOK ARG THEN
13200 LIST('EQUAL,LIST('EVAL,LIST('QUOTE,ARG)),
13250 LIST('QUOTE,EVAL ARG))
13400 ELSE 'INVALID ;
13500
13600 EVALOK ARG ← T;
13800
13900 FEXPR EVEVAL ARGS ← EVALUATEEVAL CAR ARGS;
00100 REMPROP('LAMBDA,'STAT);
00200 REMPROP('GO,'STAT);
00300 END;